home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue25 / hipsquar / ELLIPSE.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-06-07  |  2.1 KB  |  86 lines
  1. {*********************************************************}
  2. {                                                         }
  3. {     Creating Non-Rectangular Windows                    }
  4. {                                                         }
  5. {     Requires Win32 API (Delphi 2.0 or 3.0 or newer)     }
  6. {                                                         }
  7. {     Copyright ⌐ 1997 Steven J. Colagiovanni             }
  8. {                                                         }
  9. {*********************************************************}
  10.  
  11. unit ellipse;
  12.  
  13. interface
  14.  
  15. uses
  16.     Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  17.     StdCtrls, ExtCtrls;
  18.  
  19. type
  20.     TfrmEllipse = class(TForm)
  21.         Shape1: TShape;
  22.         Label1: TLabel;
  23.     Label2: TLabel;
  24.         procedure FormCreate(Sender: TObject);
  25.         procedure FormPaint(Sender: TObject);
  26.     procedure FormKeyDown(Sender: TObject; var Key: Word;
  27.       Shift: TShiftState);
  28.     private
  29.         { Private declarations }
  30.         procedure WMNCHitTest(Var Msg: TMessage); message WM_NCHITTEST;
  31.     public
  32.         { Public declarations }
  33.     end;
  34.  
  35. var
  36.     frmEllipse: TfrmEllipse;
  37.  
  38. implementation
  39.  
  40. {$R *.DFM}
  41.  
  42. procedure TfrmEllipse.WMNCHitTest(Var Msg: TMessage);
  43. begin
  44.     { Respond to left mouse button down, so we can drag window }
  45.     if GetAsyncKeyState(VK_LButton) < 0 then
  46.         Msg.Result := HTCaption
  47.     else
  48.         Msg.Result := HTClient;
  49.  
  50.     { if right mouse button down, close window }
  51.     if GetAsyncKeyState(VK_RButton) < 0 then
  52.         Close;
  53. end;
  54.  
  55. procedure TfrmEllipse.FormCreate(Sender: TObject);
  56. var
  57.     Region: hRgn;
  58. begin
  59.     { Create region, or window boundaries }
  60.     Region := CreateEllipticRgn(0, 0, Width, Height);
  61.     { Assign the region to the window }
  62.     SetWindowRgn(Handle, Region, True);
  63.  
  64.     { Do not delete region - Windows now has control
  65.         of the region. }
  66. end;
  67.  
  68. procedure TfrmEllipse.FormPaint(Sender: TObject);
  69. begin
  70.     { Paint window border }
  71.     with canvas do
  72.     begin
  73.         Pen.Color := clBlack;
  74.         Pen.Width := 2;
  75.         Ellipse(1, 1, width-2, height-2);
  76.     end;
  77. end;
  78.  
  79. procedure TfrmEllipse.FormKeyDown(Sender: TObject; var Key: Word;
  80.   Shift: TShiftState);
  81. begin
  82.     if key = VK_Escape then Close;
  83. end;
  84.  
  85. end.
  86.